(module interp (lib "eopl.ss" "eopl")
  
  (require "drscheme-init.scm")

  (require "lang.scm")
  (require "data-structures.scm")
  (require "environments.scm")

  (provide value-of-translation value-of)

;;;;;;;;;;;;;;;; the interpreter ;;;;;;;;;;;;;;;;

  ;; value-of-translation : nameless-program -> expval

  (define value-of-translation
    (lambda (pgm)
      (cases program pgm
        (a-program (body)
          (value-of body (init-env))))))

  ;; value-of : nameless-expression * environment -> expval

  (define value-of
    (lambda (exp env)
      (cases expression exp

        (const-exp (num) (num-val num))

        (diff-exp (exp1 exp2)
          (let ((val1
		  (expval->num
		    (value-of exp1 env)))
                (val2
		  (expval->num
		    (value-of exp2 env))))
            (num-val
	      (- val1 val2))))
        
        (zero?-exp (exp1)
	  (let ((val1 (expval->num (value-of exp1 env))))
	    (if (zero? val1)
	      (bool-val #t)
	      (bool-val #f))))
        


        (if-exp (exp0 exp1 exp2) 
          (if (expval->bool (value-of exp0 env))
            (value-of exp1 env)
            (value-of exp2 env)))
        
        
        (pair-exp (exp1 exp2)
                  (let ((val1 (value-of exp1 env))
                        (val2 (value-of exp2 env)))
                    (pair-gen val1 val2)
                    )
                  )

;        (unpair-exp (exp id1 id2 in-expression)
;                    (cases expval (value-of exp env)
;                      (pair-gen (val1 val2)
;                                (let ((vl1 val1)
;                                      (vl2 val2))
;                                  (value-of in-expression
;                                            (extend-env id1 vl1
;                                                        (extend-env id2 vl2 env)))))
;                      (else (eopl:error "mistake"))))
        

        
        
;         (let-exp (id rhs body)       
;           (let ((val (value-of rhs env)))
;             (value-of body
;               (extend-env id val env))))

;         (proc-exp (bvar body)
; 	  (proc-val
; 	    (procedure bvar body env)))

        (app-exp (rator rand)          
          (let ((proc (expval->proc (value-of rator env)))
                (arg  (value-of rand  env)))
	    (apply-procedure proc arg)))

	;; new entries:

	(lexref-exp (n) (apply-env env n))

	(nameless-let-exp (rhs body)
	  (let ((val (value-of rhs env)))
	    (value-of body
	      (extend-env val env))))

        (nameless-letrec-exp (procs-body letrec-body)
                             (value-of letrec-body
                                       (extend-env
                                        
                                        env)
                                       )
                             )
                             
	(nameless-proc-exp (body)
	  (proc-val
	    (procedure body env)))    
        
        (nameless-unpair-exp
         (exp1 exp2)
         (cases expval (value-of exp1 env)
           (pair-gen (val1 val2)
                     (value-of exp2
                               (extend-env val1 
                                           (extend-env val2 env))
                               )
                     )
           
           (else (eopl:error "mistake"))
           )
         )
                            
                     
                     
                     

	(else 
	  (eopl:error 'value-of 
	    "Illegal expression in translated code: ~s" exp))

	)))

  ;; apply-procedure : procedure * expval -> expval

  (define apply-procedure
    (lambda (proc1 arg)
      (cases proc proc1
        (procedure (body saved-env)
          (value-of body (extend-env arg saved-env))))))

  )
